home *** CD-ROM | disk | FTP | other *** search
- program test;
-
- uses crt;
-
- const
- TileHeight = 32; TileWidth = 32;
-
- BufWidth = 9*TileWidth; BufDestWidth = 7*TileWidth;
- BufHeight= 7*TileHeight; BufDestHeight= 5*TileHeight;
-
- BufSize = BufWidth*BufHeight;
-
- (* Pointer to beggining of VGA memory *)
- SCREEN_OFFSET = $0A000;
-
- StartingTX = 1;
- StartingTY = 4;
-
- (* Tile Constants *)
- Grass = 1;
- White = 2;
- Water = 80;
- Hero1 = 121;
- Hero2 = 122;
- Hero3 = 123;
- type
- icon32 = array [1..32,1..32] of byte;
- bufptr = ^buffertype;
- buffertype = array [1..BufSize] of byte;
- MapPtr = ^MapType;
- MapType = array [1..20,1..20] of byte;
- var
- buffer : bufptr;
- HeroPic : icon32;
- Hero2Pic,Hero3Pic : icon32;
- whitepic : icon32;
- grassPic : icon32;
- Water1Pic,Water2Pic : icon32;
- MapTX,MapTY : word;
- ch : char;
- xo,yo : integer; (* x and y offset *)
- Map : MapPtr;
- tick : byte;
- ScrollVal : byte;
-
-
- Procedure CloseUp; forward;
- procedure CopyBufferToScreen (PixelX,PixelY:word); forward;
- Procedure DrawWater (tick : byte); forward;
- Procedure Init; forward;
- Procedure LoadTile (sFileName : string; var Tile : icon32); forward;
- Procedure PlaceTileInBuffer (PixelX,PixelY:word; var Pic:icon32); forward;
- Procedure PlaceTileOnScreen (PixelX,PixelY:word; Pic:icon32); forward;
- Procedure PutDummyDataInMap; forward;
- Procedure PutHeroPic; forward;
- Procedure PutPic (TileX,TileY : word; Pic : byte); forward;
- Procedure PutPicTrans (TileX,TileY : word; Pic : byte); forward;
- Procedure SetBG; forward;
- Procedure ShowBuffer; forward;
- Procedure TestStuff; forward;
- Procedure UpdateAnimTiles; forward;
- Procedure Walk; forward;
-
-
- (**********************************************************************)
- (* Assumes buffer is 320x200 *)
- procedure CheckBuffer; assembler;
- label
- l1, l2;
- Asm
- (* Wait for Vertical Retrace *)
- cli
- mov dx,3DAh
- l1:
- in al,dx
- and al,08h
- jnz l1
- l2:
- in al,dx
- and al,08h
- jz l2
- sti
- (* End Check for Retrace *)
-
- push ds
- push es
-
- lds si,Buffer; (* load scratch page *)
- mov ax,Screen_Offset; (* load screen coords *)
- mov es,ax
- xor di,di
- mov cx,32000
- rep movsw
-
- pop es
- pop ds
- End;
- (**********************************************************************)
- Procedure CloseUp;
- Begin
- dispose (buffer);
- dispose (Map);
- asm
- mov ax,3
- int 10h
- end;
- writeln ('Thank you for running this demo');
- End;
- (**********************************************************************)
- (* Copies whole screen - buffer is not length of screen so must do *)
- (* in rows. One big sprite copy routine, really *)
- (**********************************************************************)
- procedure CopyBufferToScreen (PixelX,PixelY:word); assembler;
- const
- NumWordsLong = BufDestWidth div 2;
- Asm
- (* start real code - preserve data and extra segments *)
- push ds (* preserve segments *)
- push es
-
- (* Copy from where? *)
- lds si,Buffer (* point to start of buffer *)
-
- mov ax,BufWidth (* and figure offset *)
- mul PixelY
- add ax,PixelX
- mov si,ax
-
-
- (* Copy to where? *)
- mov ax,Screen_Offset; (* load screen coords *)
- mov es,ax (* load es from ax *)
- xor di,di (* make di = 0 *)
-
- (* Offset from top of screen *)
- mov ax,320
- mov PixelX,22 (* pixels from top *)
- mul PixelX
- add ax,45 (* pixels from left *)
- mov di,ax
-
- (* Wait for Vertical Retrace *)
- cli (* clear interrupt *)
- mov dx,3DAh (* port and sequencer stuff *)
- @@l1:
- in al,dx
- and al,08h
- jnz @@l1
- @@l2:
- in al,dx
- and al,08h
- jz @@l2
- sti (* restore interrupt *)
- (* End Check for Retrace *)
-
-
- (* Copy Data *)
- mov bx,BufDestHeight
- @@CopyRowLoop:
- mov cx,NumWordsLong (* how many words long is the row? *)
- push di (* save offset *)
- push si
- rep movsw (* copy cx words to the buffer *)
- pop si
- add si,BufWidth
- pop di (* restore offset *)
- add di,320 (* go to next line *)
- dec bx (* finished that row already *)
- jnz @@CopyRowLoop (* if there are any more rows in bx *)
- (* go ahead and do this again *)
-
-
- (* ok, we can quit now *)
- pop es
- pop ds
- End;
- (**********************************************************************)
- Procedure DrawWater (tick : byte);
- Begin
- if (tick=1) then
- begin
- PutPic (MapTX+3,MapTY,Water);
- PutPic (MapTX+3,MapTY+1,Water);
- PutPic (MapTX+2,MapTY+2,Water);
- PutPic (MapTX+2,MapTY+3,Water);
- PutPic (MapTX+3,MapTY+4,Water);
- PutPic (MapTX+3,MapTY+5,Water);
- end
- else
- begin
- PutPic (MapTX+3,MapTY,Water);
- PutPic (MapTX+3,MapTY+1,Water);
- PutPic (MapTX+2,MapTY+2,Water);
- PutPic (MapTX+2,MapTY+3,Water);
- PutPic (MapTX+3,MapTY+4,Water);
- PutPic (MapTX+3,MapTY+5,Water);
- end;
- End;
- (**********************************************************************)
- Procedure Init;
- var
- code : integer;
- Begin
- (* Set scroll increment *)
- if ParamCount > 0 then
- begin
- if paramstr(1) = '?' then
- begin
- writeln ('Usage: Scroll.exe [1/2/4/8/16/32]');
- halt(0);
- end;
- val(paramstr(1),ScrollVal,code);
- if code <> 0 then
- begin
- writeln('that''s not a valid argument');
- writeln('Usage: Scroll [1-32]');
- halt(0);
- end
- else
- begin
- if (ScrollVal<1) or (ScrollVal>32) then
- begin
- writeln('that''s not a valid argument');
- writeln('Usage: Scroll [1-32]');
- halt(0);
- end;
- end;
- end
- else
- ScrollVal:=4;
-
- Tick := 1;
-
- LoadTile ('hero1.til',HeroPic);
- LoadTile ('hero2.til',Hero2Pic);
- LoadTile ('hero3.til',Hero3Pic);
- LoadTile ('grass.til',GrassPic);
- LoadTile ('water1.til',Water1Pic);
- LoadTile ('water2.til',Water2Pic);
-
- repeat
- new (buffer);
- if ofs (buffer^) <> 0 then begin
- dispose (buffer);
- (* new (buffer); *)
- end;
- until ofs (buffer^) = 0;
-
-
- fillchar (buffer^,BufSize,#0);
-
- PutDummyDataInMap;
-
- asm
- mov ax,13h
- int 10h
- end;
-
- (* MapTX - Top Visible tile *)
- MapTX:=1; MapTY:=1;
- XO:=0; YO:=0;
- End;
- (**********************************************************************)
- Procedure LoadTile (sFileName : string; var Tile : icon32);
- var
- x,y,sPixel : byte;
- fIconFile : file of byte;
- Begin
- (* Open the File *)
- assign (fIconFile,sFileName);
- {$I-}reset(fIconFile);{$I+}
- if (IOResult <> 0) then
- begin
- writeln ('The file ',sFileName,' was not found');
- halt;
- end;
-
- (* Read from the file *)
- for y:=1 to 32 do
- for x:=1 to 32 do
- begin
- read(fIconFile,sPixel);
- Tile[y,x]:=sPixel;
- end;
-
- (* Close the file *)
- close (fIconFile);
- End;
- (**********************************************************************)
- Procedure PlaceTileOnScreen (PixelX,PixelY:word; Pic:icon32); assembler;
- const
- WordLength = TileWidth div 2;
- Asm
- (* figure pixel offset onto screen *)
- mov ax,320
- mul PixelY
- add ax,PixelX (* gives (Y*width)+x *)
-
- (* preserve data segment pointer *)
- mov dx,ds
-
- (* Copy to where? *)
- mov di,ax
- mov ax,Screen_Offset
- mov es,ax
-
- (* Copy from where? *)
- lds si,Pic
-
- (* Copy Data *)
- mov bx,TileHeight
- @@CopyRowLoop:
- mov cx,WordLength (* how many words long is the row? *)
- push di (* save offset *)
- rep movsw (* copy cx words to the buffer *)
- pop di (* restore offset *)
- add di,320 (* go to next line *)
- dec bx (* finished that row already *)
- jnz @@CopyRowLoop (* if there are any more rows in bx *)
- (* go ahead and do this again *)
-
- (* OK, all done, so quit *)
- mov ds,dx (* restore data segment pointer *)
- End;
- (**********************************************************************)
- Procedure PlaceTileOnScreenTrans (PixelX,PixelY:word; var Pic:icon32); assembler;
- const
- WordLength = TileWidth div 2;
- Asm
- (* figure pixel offset onto screen *)
- mov ax,320
- mul PixelY
- add ax,PixelX (* gives (Y*width)+x *)
-
- (* preserve data segment pointer *)
- push ds
- push es
-
- (* Copy to where? *)
- mov di,ax
- mov ax,Screen_Offset
- mov es,ax
-
- (* Copy from where? *)
- lds si,Pic
-
- (* Copy Data - Skip Pixels color 0 (black) *)
- mov bx,TileHeight
- @@CopyRowLoop:
- mov cx,TileWidth (* how many words long is the row? *)
- push di (* save offset *)
- (*push si*)
- @@PutPixel:
- (* xor ax,ax*) (* clear ax - we're gonna use it *)
- (* cmp 0,[ds:si] *)
- mov ax,[ds:si]
- cmp ax,0 (* is this a black (#0) pixel? *)
- je @@SkipPixel (* if so, skip it (goto SkipPixel *)
- movsb (* copy cx words to the buffer *)
- loop @@PutPixel (* keep looping until cx=0 *)
-
- (* Move to Next Row *)
- (* pop si
- add si,320 *)
- @@EndOfRow:
- pop di (* restore offset *)
- add di,320 (* go to next line *)
- dec bx (* finished that row already *)
- jnz @@CopyRowLoop (* if there are any more rows in bx *)
- (* go ahead and do this again *)
- jmp @@Done
-
- @@SkipPixel:
- inc di
- inc si
- dec cx
- cmp cx,0 (* are we at the end of the row? *)
- je @@EndOfRow (* if so, go to end of row line *)
- jmp @@PutPixel (* otherwise, do the next pixel *)
-
-
- (* OK, all done, so quit *)
- @@Done:
- pop es
- pop ds
- End;
- (**********************************************************************)
- Procedure PlaceTileInBuffer (PixelX,PixelY:word; var Pic:icon32); assembler;
- const
- WordLength = TileWidth div 2;
- Asm
- (* figure pixel offset in buffer *)
- mov ax,BufWidth
- mul PixelY
- add ax,PixelX (* gives (Y*width)+x *)
-
- (* preserve data segment pointer *)
- mov dx,ds
-
- (* Copy to where? *)
- les di,buffer
- mov di,ax
-
- (* Copy from where? *)
- lds si,Pic
-
- (* Copy Data *)
- mov bx,TileHeight
- @@CopyRowLoop:
- mov cx,WordLength (* how many words long is the row? *)
- push di (* save offset *)
- rep movsw (* copy cx words to the buffer *)
- pop di (* restore offset *)
- add di,BufWidth (* go to next line *)
- dec bx (* finished that row already *)
- jnz @@CopyRowLoop (* if there are any more rows in bx *)
- (* go ahead and do this again *)
-
- (* OK, all done, so quit *)
- mov ds,dx (* restore data segment pointer *)
- End;
- (**********************************************************************)
- Procedure PlaceTileInBufferTrans (PixelX,PixelY:word; var Pic:icon32); assembler;
- const
- WordLength = TileWidth div 2;
- Asm
- (* figure pixel offset in buffer *)
- mov ax,BufWidth
- mul PixelY
- add ax,PixelX (* gives (Y*width)+x *)
-
- (* preserve data segment pointer *)
- push es
- push ds
-
- (* Copy to where? *)
- les di,buffer
- mov di,ax
-
- (* Copy from where? *)
- lds si,Pic
-
- (* Copy Data - Don't draw black (color 0) pixels *)
- mov bx,TileHeight
- @@CopyRowLoop:
- mov cx,TileWidth (* how many words long is the row? *)
- push di (* save offset *)
- @@PutPixel:
- mov ax,[ds:si]
- cmp ax,0 (* is this a black (#0) pixel? *)
- je @@SkipPixel (* if so, skip it (goto SkipPixel *)
- movsb (* copy cx words to the buffer *)
- loop @@PutPixel (* keep looping until cx=0 *)
-
- (* Move to Next Row *)
- @@EndOfRow:
- pop di (* restore offset *)
- add di,BufWidth (* go to next line *)
- dec bx (* finished that row already *)
- jnz @@CopyRowLoop (* if there are any more rows in bx *)
- (* go ahead and do this again *)
- jmp @@Done
-
- @@SkipPixel:
- inc di
- inc si
- dec cx
- cmp cx,0 (* are we at the end of the row? *)
- je @@EndOfRow (* if so, go to end of row line *)
- jmp @@PutPixel (* otherwise, do the next pixel *)
-
- (* OK, all done, so quit *)
- @@Done:
- pop ds (* restore data segment pointer *)
- pop es
- End;
-
- (**********************************************************************)
- Procedure PutDummyDataInMap;
- var
- x,y : byte;
- Begin
- new (Map);
-
- for y:=1 to 20 do
- for x:=1 to 20 do
- Map^[x,y]:=Grass;
-
- (* add a river *)
- Map^[4,1]:=Water;
- Map^[3,1]:=Water;
- Map^[4,2]:=Water;
- Map^[4,3]:=Water;
- Map^[3,3]:=Water;
- Map^[3,4]:=Water;
- Map^[3,5]:=Water;
- Map^[4,5]:=Water;
- Map^[4,6]:=Water;
- Map^[4,7]:=Water;
- Map^[3,7]:=Water;
- Map^[3,8]:=Water;
- Map^[3,9]:=Water;
- Map^[4,9]:=Water;
-
- Map^[4,10]:=Water;
- Map^[4,11]:=Water;
- Map^[3,11]:=Water;
- Map^[3,12]:=Water;
- Map^[3,13]:=Water;
- Map^[4,13]:=Water;
- Map^[4,14]:=Water;
- Map^[4,15]:=Water;
- Map^[3,15]:=Water;
- Map^[3,16]:=Water;
- Map^[3,17]:=Water;
- Map^[4,17]:=Water;
- Map^[4,18]:=Water;
- Map^[4,19]:=Water;
- Map^[3,19]:=Water;
- Map^[3,20]:=Water;
- (*
- Map^[4,10]:=Water;
- Map^[3,10]:=Water;
- Map^[3,11]:=Water;
- Map^[3,12]:=Water;
- Map^[4,12]:=Water;
- Map^[5,12]:=Water;
- Map^[5,13]:=Water;
- Map^[5,14]:=Water;
- Map^[5,15]:=Water;
- Map^[4,16]:=Water;
- Map^[4,17]:=Water;
- Map^[4,18]:=Water;
- Map^[4,19]:=Water;
- Map^[3,19]:=Water;
- Map^[3,20]:=Water;
- Map^[2,20]:=Water;
-
- *)
- End;
- (**********************************************************************)
- Procedure PutHeroPic;
- (* Hero should go in the center - 4,3 (0 is first) plus any *)
- (* changes in offset *)
- var
- PixelX,PixelY : word;
- Begin
- (* Convert World Tile Coords to Pixel in Buffer *)
- PixelX:=4*TileWidth; PixelY:=3*TileHeight;
- PixelX:=PixelX+XO; PixelY:=PixelY+YO;
-
- (* copy the data into the buffer *)
- (* PlaceTileInBuffer (pixelx,pixely,HeroPic); *)
- PlaceTileInBufferTrans (PixelX,PixelY,HeroPic);
- End;
- (**********************************************************************)
- Procedure PutPic (TileX,TileY : word; Pic : byte);
- (* Tile 0 = first tile (the buffer's border) *)
- (* Tile 1 = first tile visible to map *)
- (* MapTX = Top Left Buffer Border Tile. *)
- (* Tile's are world Coordinates, not buffer coords *)
- (* Should never get a TileX/Y or MapTX/Y under 0 *)
- var
- PixelX,PixelY : word;
- Begin
- (* Convert World Tile Coords to Pixel in Buffer *)
- (* Figure Where tile goes in relation to Top Left Tile *)
- PixelX:=TileX-MapTX;
- PixelY:=TileY-MapTY;
-
- (* and multiply by tile width *)
- PixelX:=PixelX*TileWidth;
- PixelY:=PixelY*TileHeight; (* same as shl 5 *)
-
- (* copy data into the buffer *)
- case Pic of
- Grass : PlaceTileInBuffer (pixelx,pixely,GrassPic);
- White : PlaceTileInBuffer (pixelx,pixely,WhitePic);
- Water : begin
- if tick = 0 then
- PlaceTileInBuffer (pixelx,pixely,Water1Pic)
- else
- PlaceTileInBuffer (pixelx,pixely,Water2Pic);
- end;
- Hero1 : PlaceTileInBuffer (pixelx,pixely,HeroPic);
- Hero2 : PlaceTileInBuffer (pixelx,pixely,Hero2Pic);
- Hero3 : PlaceTileInBuffer (pixelx,pixely,Hero3Pic);
- end; (* case *)
- End;
- (**********************************************************************)
- Procedure PutPicTrans (TileX,TileY : word; Pic : byte);
- var
- PixelX,PixelY : word;
- Begin
- (* Convert World Tile Coords to Pixel in Buffer *)
- (* Figure Where tile goes in relation to Top Left Tile *)
- PixelX:=TileX-MapTX;
- PixelY:=TileY-MapTY;
-
- (* and multiply by tile width *)
- PixelX:=PixelX*TileWidth;
- PixelY:=PixelY*TileHeight; (* same as shl 5 *)
-
- (* and check for scrolling - move offset *)
- PixelX:=PixelX+XO;
- PixelY:=PixelY+YO;
-
- (* copy data into the buffer *)
- case Pic of
- Grass : PlaceTileInBufferTrans (pixelx,pixely,GrassPic);
- White : PlaceTileInBufferTrans (pixelx,pixely,WhitePic);
- Water : begin
- if tick = 0 then
- PlaceTileInBufferTrans (pixelx,pixely,Water1Pic)
- else
- PlaceTileInBufferTrans (pixelx,pixely,Water2Pic);
- end;
- Hero1 : PlaceTileInBufferTrans (pixelx,pixely,HeroPic);
- Hero2 : PlaceTileInBufferTrans (pixelx,pixely,Hero2Pic);
- Hero3 : PlaceTileInBufferTrans (pixelx,pixely,Hero3Pic);
- end; (* case *)
- End;
-
- (**********************************************************************)
- Procedure SetBG;
- var
- x,y : byte;
- Begin
- for y:= MapTY to MapTY+6 do
- for x:=MapTX to MapTX+8 do
- PutPic (x,y,Map^[x,y]);
- End;
- (**********************************************************************)
- Procedure ShowBuffer;
- var
- PixelX,PixelY : word;
- Begin
- (* Update any Animated Tiles *)
- UpdateAnimTiles;
-
- (* Copy center squares, ignore the 1 tile buffer *)
- PixelX:=TileWidth; (* skip the first tile (the border) *)
- PixelY:=TileHeight;
-
- (* now adjust for scrolling *)
- PixelX:=PixelX+XO;
- PixelY:=PixelY+YO;
-
- (* copy the data to the screen *)
- CopyBufferToScreen (PixelX,PixelY);
- End;
- (**********************************************************************)
- Procedure TestStuff;
- const
- WS = 1000;
- var
- x,y : byte;
- Begin
- (* Top Visible Corner is MapTX+1 MapTY+1 *)
- MapTX:=StartingTX; MapTY:=StartingTY;
-
- SetBG;
-
- repeat
- Walk;
- until keypressed;
-
- (* Walk; *)
- ch:=readkey; (* clear buffer *)
- End;
- (**********************************************************************)
- Procedure UpdateAnimTiles;
- var
- x,y : byte;
- Begin
- (* Search through the map and update any animated tiles *)
- for y:= MapTY to MapTY+6 do
- for x:=MapTX to MapTX+8 do
- if (Map^[x,y]>79) and (Map^[MapTX,MapTY]<121) then
- PutPic(x,y,Map^[x,y]);
-
- (* Update master tick *)
- if tick=0 then tick:=1 else tick:=0;
- End;
- (**********************************************************************)
- Procedure Walk;
- const
- WS = 400;
- NumPixels = -32; (* number of pixels to walk *)
- NumTiles = StartingTY;
- var
- OldY : integer;
- tick : byte;
- walktick : byte;
- TilesWalked : byte;
- Step : byte;
- Begin
- YO:=0;
- OldY:=YO;
- tick:=1;
- walktick := 1;
- TilesWalked:=0;
- Step:=ScrollVal;
-
- MapTX:=StartingTX; MapTY:=StartingTY;
- SetBG;
-
- repeat
- (* Center square is MapTX+4, MapTY+3 *)
- (* Next square up is MapTX+4, MapTY+2 *)
-
- (* erase old image *)
- putpic (MapTX+4,MapTY+3,Map^[MapTX+4,MapTY+3]);
- putpic (MapTX+4,MapTY+2,Map^[MapTX+4,MapTY+2]);
-
- (* move foward 4 spaces *)
- dec(YO,Step);
-
- (* draw new position *)
- case WalkTick of
- 0,2 : PutPicTrans (MapTX+4,MapTY+3,Hero1);
- 1 : PutPicTrans (MapTX+4,MapTY+3,Hero2);
- 3 : PutPicTrans (MapTX+4,MapTY+3,Hero3);
- end;
- inc(walktick);
- if walktick=4 then walktick:=0;
-
- (* show screen *)
- ShowBuffer;
-
- (* and wait a bit *)
- delay (WS);
-
- if (YO <= -32) then
- begin
- inc(TilesWalked);
- YO:=0;
- dec(MapTY);
- SetBG;
- end;
- until (TilesWalked=NumTiles);
-
- (* ok, for the last time erase his old position *)
- putpic (MapTX+4,MapTY+3,Map^[MapTX+4,MapTY+3]);
- putpic (MapTX+4,MapTY+2,Map^[MapTX+4,MapTY+3]);
-
- (* Move the map up one and stop the scrolling offset *)
- YO:=0;
- dec(MapTY);
-
- (* Now that the MapTY has changed, we have to draw new tiles *)
- SetBG;
-
- (* Show him in standing position at end *)
- PutPicTrans (MapTX+4,MapTY+3,Hero1);
- ShowBuffer;
- End;
- (**********************************************************************)
- (**********************************************************************)
- BEGIN
- Init;
- TestStuff;
- CloseUp;
- END.